home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / codegen / lambdaopt.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.2 KB  |  109 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2.  
  3. structure LambdaOpt : sig val lambdaopt: Lambda.lexp -> Lambda.lexp end =
  4. struct
  5.  
  6. open Access Lambda
  7. fun click a = if !System.Control.CG.misc1 then System.Print.say a else ()
  8.             
  9. fun last [x] = x | last(a::r) = last r
  10.  
  11. fun lambdaopt lexp = if not(!System.Control.CG.lambdaopt )
  12.              then lexp else
  13. let exception LambdaOpt
  14.     val m : (int * lexp) Intmap.intmap 
  15.          = Intmap.new(32,LambdaOpt)
  16.     val enter = Intmap.add m
  17.     val get0 = Intmap.map m
  18.     fun get v = SOME(get0 v) handle LambdaOpt => NONE
  19.     val kill = Intmap.rmv m
  20.  
  21.  fun all p (a::r) = p a andalso all p r | all p nil = true
  22.  
  23.  val rec reduce_ok =
  24.   fn VAR v => true
  25.    | APP(FN(v,_,a),b) => (reduce_ok a andalso reduce_ok b)
  26.    | FN(v,_,e) => true
  27.    | PRIM _ => true
  28.    | INT _ => true
  29.    | REAL _ => true
  30.    | STRING _ => true
  31.    | _ => false
  32.      (* It's dangerous, for reasons of space complexity, 
  33.       to hoist the operators SELECT, DECON, SWITCH,
  34.       FIX, and HANDLE downwards.  The operators 
  35.       APP, RAISE might have a sideeffect. 
  36.       And, even though it's safe, there's not much point in
  37.       optimizing "let v = RECORD ... " because cps-conversion
  38.       will just re-introduce the "let" expression. 
  39.     *)
  40.  
  41.  val rec pass1 =
  42.   fn VAR v => (case get v
  43.             of SOME(0,e) => enter(v,(1,e))
  44.          | SOME _ => kill v
  45.          | NONE => ())
  46.    | APP(FN(v,_,a),b) => (if reduce_ok b
  47.                  then enter(v, (0,b)) else ();
  48.                 pass1 a; pass1 b)
  49.    | FN(v,_,e) => pass1 e
  50.    | FIX(fl,_,el,b) => (app pass1 el; pass1 b)
  51.    | APP(a,b) => (pass1 a; pass1 b)
  52.    | SWITCH(e,_,l,NONE) => (pass1 e; app conpass1 l)
  53.    | SWITCH(e,_,l,SOME d) => (pass1 e; app conpass1 l; pass1 d)
  54.    | CON(c,e) => conpass1(DATAcon c, e)
  55.    | DECON(c,e) => conpass1(DATAcon c, e)
  56.    | RECORD el => app pass1 el
  57.    | VECTOR el => app pass1 el
  58.    | SELECT(_,e) => pass1 e
  59.    | RAISE(e,_) => pass1 e
  60.    | HANDLE(a,b) => (pass1 a; pass1 b)
  61.    | PRIM _ => ()
  62.    | INT _ => ()
  63.    | REAL _ => ()
  64.    | STRING _ => ()
  65.    | WRAP(_,e) => pass1 e
  66.    | UNWRAP(_,e) => pass1 e
  67.  
  68.  and conpass1 =
  69.    fn (DATAcon(_,VARIABLE(PATH p),_), e) =>(kill(last p); pass1 e)
  70.     | (DATAcon(_,VARIABLEc(PATH  p),_), e) =>(kill(last p); pass1 e)
  71.     | (_,e) => pass1 e
  72.  
  73.  val rec g =
  74.   fn a as VAR v => (case get v
  75.              of SOME(_,e) => (kill v; g e)
  76.               | NONE => a)
  77.    | FN(v,t,b) => FN(v, t, g b)
  78.    | APP(a as FN(v,_,e), b) =>
  79.       (case get v
  80.             of SOME(1,_) => (click "$"; g e)
  81.              | SOME _ => (kill v; click "#"; g e)
  82.          | NONE => APP(g a, g b))
  83.    | FIX(fl,t,el,b) => FIX(fl, t, map g el, g b)
  84.    | APP(a as VAR f, b) => 
  85.           (case get f
  86.         of SOME(_,e) => (kill f; click "%"; g(APP(e,b)))
  87.          | NONE => APP(a, g b))
  88.    | APP(a,b) => APP(g a, g b)
  89.    | SWITCH(e,cl,el,d) => 
  90.       SWITCH(g e, cl, 
  91.          map (fn (c,e) => (c, g e)) el,
  92.          case d of SOME d' => SOME(g d') | NONE => NONE)
  93.    | CON(c,e) => CON(c, g e)
  94.    | DECON(c,e) => DECON(c, g e)
  95.    | RECORD el => RECORD (map g el)
  96.    | VECTOR el => VECTOR (map g el)
  97.    | SELECT(i,e) => SELECT(i, g e)
  98.    | RAISE(e,t) => RAISE(g e,t)
  99.    | HANDLE(a,b) => HANDLE(g a, g b)
  100.    | WRAP(t,e) => WRAP(t,g e)
  101.    | UNWRAP(t,e) => UNWRAP(t,g e)
  102.    | e => e
  103.  in click "Lambda Opt: \n"; pass1 lexp;
  104.      g lexp before click "\n"
  105. end
  106.  
  107. end
  108.  
  109.